home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / tpl60n19.zip / TESTPRGS.ZIP / ULPERR.PAS < prev    next >
Pascal/Delphi Source File  |  1993-02-14  |  4KB  |  135 lines
  1. PROGRAM ULPerr; { Copyright (c) 1993 Norbert Juffa }
  2.  
  3. {$N+,E-,A+}
  4.  
  5. USES FUN1_TP6, CRT;
  6.  
  7. TYPE  ExtMathFun =  FUNCTION (X: EXTENDED): EXTENDED;
  8.       TestFunctions = (Sine, Cosine, Atan, Log, Expo);
  9.       Bounds = ARRAY [1..2] OF EXTENDED;
  10.  
  11. VAR   Z:  EXTENDED;
  12.       ZA: ARRAY [1..10] OF BYTE ABSOLUTE Z;
  13.       ZW: ARRAY [1..5] OF WORD ABSOLUTE Z;
  14.       Y:  EXTENDED;
  15.       YA: ARRAY [1..10] OF BYTE ABSOLUTE Y;
  16.       YW: ARRAY [1..5] OF WORD ABSOLUTE Y;
  17.       X:  REAL;
  18.       Step,UlpError, MinUlpErr, MaxUlpErr: EXTENDED;
  19.       YR, ZR:REAL;
  20.       Total, Wrong: LONGINT;
  21.       CoproFun:     ARRAY [Sine..Expo] OF ExtMathFun;
  22.       SoftwareFun:  ARRAY [Sine..Expo] OF RealMathFun;
  23.       L: TestFunctions;
  24.  
  25. CONST Trials = 1000000;
  26.       FunName:    ARRAY [Sine..Expo] OF STRING =
  27.                   ('SIN', 'COS', 'ARCTAN', 'LN', 'EXP');
  28.       FunIntvl:   ARRAY [Sine..Expo] OF Bounds =
  29.                   ((-0.5*PI, 0.5*PI), (-0.5*PI, 0.5*PI), (-20.0, 20.0),
  30.                    (0.001, 20.0), (-88.0, 88.0));
  31.  
  32. FUNCTION CoproSin (X: EXTENDED): EXTENDED; FAR;
  33. BEGIN
  34.    CoproSin := Sin (X);
  35. END;
  36.  
  37. FUNCTION CoproCos (X: EXTENDED): EXTENDED; FAR;
  38. BEGIN
  39.    CoproCos := Cos (X);
  40. END;
  41.  
  42. FUNCTION CoproExp (X: EXTENDED): EXTENDED; FAR;
  43. BEGIN
  44.    CoproExp := Exp (X);
  45. END;
  46.  
  47. FUNCTION CoproLn (X: EXTENDED): EXTENDED; FAR;
  48. BEGIN
  49.    CoproLn := Ln (X);
  50. END;
  51.  
  52. FUNCTION CoproArctan (X: EXTENDED): EXTENDED; FAR;
  53. BEGIN
  54.    CoproArcTan := ArcTan (X);
  55. END;
  56.  
  57.  
  58. BEGIN
  59.    CoproFun [Sine]   := CoproSin;
  60.    CoproFun [Cosine] := CoproCos;
  61.    CoproFun [Atan]   := CoproArctan;
  62.    CoproFun [Log]    := CoproLn;
  63.    CoproFun [Expo]   := CoproExp;
  64.  
  65.    SoftwareFun [Sine]   := SW_Sin;
  66.    SoftwareFun [Cosine] := SW_Cos;
  67.    SoftwareFun [Atan]   := SW_Arctan;
  68.    SoftwareFun [Log]    := SW_Ln;
  69.    SoftwareFun [Expo]   := SW_Exp;
  70.  
  71.  
  72.    WriteLn ('******** Test of REAL transcendental function using coprocessor ********');
  73.  
  74.    FOR L := Sine TO Expo DO BEGIN
  75.       WriteLn;
  76.       WriteLn;
  77.       WriteLn;
  78.       WriteLn ('Test of function ', FunName [L]:6, ' in interval (',
  79.                FunIntvl [L, 1]:15, ' .. ', FunIntvl [L, 2]:15, ')');
  80.       WriteLn;
  81.       WriteLn ('       x             total     wrong       -ULPerr         + ULPerr');
  82.       WriteLn;
  83.       X := FunIntvl [L, 1];
  84.       Step := (FunIntvl [L, 2] - FunIntvl [L, 1]) / (Trials);
  85.       MinUlpErr := 0;
  86.       MaxUlpErr := 0;
  87.       Total := 0;
  88.       Wrong := 0;
  89.       WHILE X <= FunIntvl [L, 2] DO BEGIN
  90.          Inc (Total);
  91.          Y := SoftwareFun [L] (X);
  92.          Z := CoproFun [L] (X);
  93.          YR := Y;
  94.          ZR := Z;
  95.          IF YR <> ZR THEN
  96.             Inc (Wrong);
  97.  
  98.          IF YW[5] > ZW[5] THEN
  99.             UlpError := ((((((((YA[8]*256.0+YA[7])*256.0+YA[6])*256.0+YA[5])
  100.                         *256.0+YA[4])*256.0+YA[3])*256.0+YA[2])*256.0+YA[1])*2-
  101.                         (((((((ZA[8]*256.0+ZA[7])*256.0+ZA[6])*256.0+ZA[5])
  102.                         *256.0+ZA[4])*256.0+ZA[3])*256.0+ZA[2])*256.0+ZA[1]))/
  103.                         16777216.0
  104.          ELSE IF YW[5] < ZW[5] THEN
  105.             UlpError := ((((((((YA[8]*256.0+YA[7])*256.0+YA[6])*256.0+YA[5])
  106.                         *256.0+YA[4])*256.0+YA[3])*256.0+YA[2])*256.0+YA[1])-
  107.                         (((((((ZA[8]*256.0+ZA[7])*256.0+ZA[6])*256.0+ZA[5])
  108.                         *256.0+ZA[4])*256.0+ZA[3])*256.0+ZA[2])*256.0+ZA[1])*2)/
  109.                         16777216.0
  110.          ELSE UlpError := ((((((((YA[8]*256.0+YA[7])*256.0+YA[6])*256.0+YA[5])
  111.                           *256.0+YA[4])*256.0+YA[3])*256.0+YA[2])*256.0+YA[1]) -
  112.                           (((((((ZA[8]*256.0+ZA[7])*256.0+ZA[6])*256.0+ZA[5])
  113.                           *256.0+ZA[4])*256.0+ZA[3])*256.0+ZA[2])*256.0+ZA[1])) /
  114.                           16777216.0;
  115.  
  116.          IF (YR <> 0) AND (ZR <> 0) THEN
  117.             IF (UlpError < MinUlpErr) THEN
  118.                MinUlpErr := UlpError
  119.             ELSE IF (UlpError > MaxUlpErr) THEN
  120.                MaxUlpErr := UlpError;
  121.  
  122.          X := X + (Step);
  123.  
  124.          IF Total AND $FFF = 0 THEN BEGIN
  125.             GotoXY (1, WhereY);
  126.             ClrEol;
  127.             Write (X:16, Total:10, Wrong:10, '  ', MinUlpErr:16, '  ', MaxUlpErr:16);
  128.          END;
  129.       END;
  130.       GotoXY (1, WhereY);
  131.       ClrEol;
  132.       WriteLn (X:16, Total:10, Wrong:10, '  ', MinUlpErr:16, '  ', MaxUlpErr:16);
  133.    END;
  134. END.
  135.